CD ROM Paradise Collection 4/CD ROM Paradise Collection 4 1995 Nov.iso/program/tjgold.zip/INSTALL.002/GOLDWIN.PAS

Pascal/Delphi Source File | 1995-07-12 | 81KB | 2,664 lines

{--------------------------------------------------------------------------}
{                Product: TechnoJock's Turbo Toolkit                       }
{                Version: GOLD                                             }
{                Build:   1.01                                             }
{                                                                          }
{                Copyright 1986-1995  TechnoJock Software, Inc.            }
{                           All Rights Reserved                            }
{                          Restricted by License                           }
{--------------------------------------------------------------------------}

                     {********************************}
                     {**      Unit:   GOLDWIN       **}
                     {********************************}

{++++++++++++++++++++++++++++++} unit GOLDWIN; {++++++++++++++++++++++++++++}

{$I GOLDFLAG.INC}
{$IFNDEF GOLDWIN}
   {$DEFINE GOLDWIN}
{$ENDIF}

{++++++++++++++++++++++++++++++++} INTERFACE {+++++++++++++++++++++++++++++++}

uses DOS, CRT,
     GoldAttr, GoldHard, GoldTint, GoldMisc,
     GoldLink, GoldKey, GoldFast, GoldStr;

const
   MaxWindows = 10;          {Change this constant as necessary}

type
   WinType         = (WPlain, WClose, WMove, WMoveNoClose, WStretch);
   DeskWinNumState = (WNoNumbers,WShowNumbers,WUseDefaults);
   WindowPtr = ^WindowImage;
   WindowImage = record
      ScreenPtr: Pointer;     {pointer to screen data}
      Coord    : gByteCoords; {window coords}
      CursorX  : byte;        {cursor location}
      CursorY  : byte;
      ScanTop  : byte;        {cursor shape}
      ScanBot  : byte;
   end;

   {button structure}
   ButtonZone = record
     X1,X2: byte;
     ButtonFace: StrButton;
   end;

   ThreeButs = array [1..3] of ButtonZone;

   WinSet = record
      LastECode: integer;
      EMsgFunc: ErrMsgFunc;
      FirstWin: WStructurePtr; {structure declared in GOLDFAST}
      TopWin: WStructurePtr;
      RotateKey: word;         {key to switch to next window in list}
      CloseKey: word;          {key to close the window}
      MoveKey: word;           {key to invoke manual window move}
      ZoomKey:word;            {keycode for zoom}
      StretchKey:word;         {keycode for manual stretch}
      PromptStyle: byte;       {window style for ad-hoc messages}
      DesktopFadeStyle: byte;  {window style when not top window}
      DesktopFocusStyle: byte; {window style when of top window on desktop}
      DesktopActive: boolean;
      DesktopNums: DeskWinNumState;  {should Desktop windows show numbers}
      DesktopCascadeNew: boolean;    {should new windows be placed down-left of prev}
      {defaults for new windows}
      WinState: byte;
      Boundary: gCoords;       {max area in which window can move}
      Scroll: ScrollType;      {are scroll bars supported}
      MinWidth: byte;          {min width of SmartWin}
      MinDepth: byte;          {min depth of SmartWin}
      {window icons}
      WinCloseChar: char;
      WinCloseCharDown: char;
      WinZoomMaxChar: char;
      WinZoomBackChar: char;
      {move message}
      WinMoveMsgPart1:string[40];
      WinMoveMsgPart2:string[30];
      {buttons}
      OKButStr: strButton;
      OKHotKey: word;
      CancelButStr: strButton;
      CancelHotKey: word;
      YesButStr: strButton;
      YesHotKey: word;
      NoButStr: strButton;
      NoHotKey: word;
      HelpButStr: strButton;
      HelpHotKey: word;
   end; {WinSet}

const
    {bit positions for WinState settings}
    WinAllowClose    = 0;   {is close icon active}
    WinAllowMove     = 1;   {can window be moved}
    WinShowNum       = 2;   {display window number in border}
    WinAllowStretch  = 3;   {is user allowed to stretch}
    WinSmartStretch  = 4;   {is there a callback function for the stretch}
    WinZoomed        = 5;   {is the window zoomed}
    (* Following defined in GOLDFAST
    WinConfine       = 6;   {restrict screen writes to WX1..WY2}
    *)
    DeskTileKey      = 1000;
    DeskCascadeKey   = 1001;

var
   {old style windows}
   Win: array[1..MaxWindows] of WindowPtr;
   {Gold Windows}
   WinVars: WinSet;

{misc procs}
function  LastWinError: integer;
procedure NoStretchHook(X1,Y1,X2,Y2:byte);
procedure NoKeyHandler;
 function BasicCloseHandler(Handle: integer): boolean;
procedure BasicFocusHandler(Handle: integer);
{the old TTT5 routines for backward compatibility}
procedure Mkwin(x1,y1,x2,y2,FB,boxtype:integer);
procedure GrowMkwin(x1,y1,x2,y2,FB,boxtype:integer);
procedure Rmwin;
{Gold Windows}
procedure ActivateWindow(Win:word);
procedure ActivateTopWindow;
function  WindowHasFocus: boolean;
function  WinCount:integer;
function  WinPtr(WinNum:integer):WStructurePtr;
function  WinCreate(X1,Y1,X2,Y2:integer;Style:byte): integer; {returns window handle}
procedure WinSetPosition(Win:integer;NewX,NewY:shortint);
procedure WinSetMinSize(Win:integer;Width,Depth: byte);
procedure WinSetType(Win:integer;W:WinType);
procedure WinSetScrollType(Win:integer;S:ScrollType);
procedure WinSetColor(Win:integer; A:TintElement;C:byte);
procedure WinSetShowNum(Win:integer;On:boolean);
procedure WinSetTitle(Win:integer;Tit:string);
procedure WinSetStretchProc(Win:integer;S:StretchProc);
procedure WinSetFrame(Win:integer;Bright:boolean);
procedure WinDisplay(Win:integer);
procedure WinDispose(Win:integer);
{Scroll bar borders}
procedure DrawHorizBar(WinId:integer;Current,Max: longint);
procedure DrawVertBar(WinId:integer;Current,Max: longint);
{focus/desktop management}
procedure WinFadeTopWin;
procedure WinFocusTopWin;
procedure WinChangeFocus(WinId:integer);
function  WinWithFocus:integer;
procedure WinShiftFocus;
procedure DeskNextWinCoords(var TLX,TLY: byte);
{key management functions}
function  IsWinKey(K:word;KX,KY:integer):boolean;
function  IsFocusKey(K:word;KX,KY:Integer):byte;
procedure WinProcessKey(var K:word; var KX,KY:byte);
function  WinGlobalX(WinId:integer;X1:byte):byte;
function  WinLocalX(WinId:integer;X1:byte):byte;
function  WinGlobalY(WinId:integer;Y1:byte):byte;
function  WinLocalY(WinId:integer;Y1:byte):byte;
{message displaying procs}
procedure TempMessageCh(X,Y,FB:integer;St:strscreen;var Ch : char);procedure TempMessage(X,Y,FB:integer;St:strscreen);
procedure TempMessageBoxCh(X1,Y1,FB,BoxType:integer;St:strscreen;var Ch : char);
procedure TempMessageBox(X1,Y1,FB,BoxType:integer;St:strscreen);
{Prompt Dialogs}
procedure PromptOK(Tit,Str:string);
function  PromptOKCancel(Tit,Str:string): byte;
function  PromptYesNo(Tit,Str:string): byte;
function  PromptCustom(Tit,Str:string; But1,But2,But3:StrButton; HK1,HK2,HK3,Default:word; WaitTime:longint): byte;
procedure PromptOKStrLL(Tit:string;StrLL:StringLL);
function  PromptOKCancelStrLL(Tit:string;StrLL:StringLL): byte;
function  PromptYesNoStrLL(Tit:string;StrLL:StringLL): byte;
function  PromptCustomStrLL(Tit:string; StrLL:StringLL; But1,But2,But3:StrButton;
                      HK1,HK2,HK3,Default:word; WaitTime:longint): byte;

{dragging}
procedure DragItem(var X1,Y1,X2,Y2:byte;DragAttr:byte;UsingMouse:boolean;Fillch:char;FillAttr:byte);
{general}
procedure WinDefaultSettings;
procedure GoldWinInit;
{internal}
procedure MkPopUpWin(var x1,y1,x2,y2:integer; FB1,FB2,style:byte);
procedure WinPaint(Win:integer);
procedure CreateWin(x1,y1,x2,y2:integer);
function  PrevWinInChain(WCP:WStructurePtr): WStructurePtr;
procedure WinStretch(UsingMouse:boolean;OldX,OldY:byte);
procedure WinPostStretch(X1,Y1,X2,Y2: integer);



{+++++++++++++++++++++++++++++} IMPLEMENTATION {+++++++++++++++++++++++++++++}
CONST
   TopWin = 0;
   WindowCounter: byte = 0;

                      {******************************}
                      {**  Miscellaneous Routines  **}
                      {******************************}
{$IFOPT F-}
   {$DEFINE FOFF}
   {$F+}
{$ENDIF}
function WinEMsg(ECode:integer): string;
{}
begin
   case Ecode of
      0: exit;
      else
         WinEMsg := 'Internal Window error';
   end; {case}
end; { WinEMsg }
{$IFDEF FOFF}
   {$F-}
   {$UNDEF FOFF}
{$ENDIF}

procedure WinSetError(ECode:integer);
{}
{$IFOPT D+}
var Msg: string;
{$ENDIF}
begin
   WinVars.LastEcode := ECode;
{$IFOPT D+}  {if debug active display an error message and terminate}
   if Ecode <> 0 then
   begin
      str(Ecode,Msg);
      Msg := Msg+': '+WinVars.EMsgFunc(Ecode);
      SetWinIgnore(true);
      if PromptCustom(' GoldWin Error ',Msg,' ~I~gnore ',' ~A~bort ','',279,286,0,0, 10000) = 2 then
         Halt;
   end;
{$ENDIF}
end; {WinSetError}

function LastWinError: integer;
{}
begin
   LastWinError := WinVars.LastECode;
end; { LastWinError }

{$IFOPT F-}
   {$DEFINE FOFF}
   {$F+}
{$ENDIF}

 procedure NoStretchHook(X1,Y1,X2,Y2:byte);
 {empty proc}
 begin end; {NoStretchHook}

 procedure NoKeyHandler;
 {empty proc}
 begin end; {NoKeyHandler}

 function BasicCloseHandler(Handle: integer): boolean;
 {}
 begin
    WinDispose(Handle);
    BasicCloseHandler := true;
 end; {BasicCloseHandler}

 procedure BasicFocusHandler(Handle: integer);
 {empty proc}
 begin end; {BasicFocusHandler}

{$IFDEF FOFF}
   {$F-}
   {$UNDEF FOFF}
{$ENDIF}

                   {***********************************}
                   {**  Traditional Window Routines  **}
                   {***********************************}

procedure VerifyWindowOnScreen(var x1,y1,x2,y2:integer);
{INTERNAL}
var Delta: integer;
begin
   if X1 < 1 then
   begin
      inc(X2,succ(abs(X1)));
      inc(X1,succ(abs(X1)));
   end else if X2 > HardVars.Width then
   begin
      Delta := X2 - HardVars.Width;
      dec(X2,Delta);
      dec(X1,Delta);
   end;
   if X1 < 1 then
      X1 := 1;
   if X2 > HardVars.Width then
      X2 := HardVars.Width;
   {Now the Y coords}
   if Y1 < 1 then
   begin
      inc(Y2,succ(abs(Y1)));
      inc(Y1,succ(abs(Y1)));
   end else if Y2 > HardVars.Depth then
   begin
      Delta := Y2 - HardVars.Depth;
      dec(Y2,Delta);
      dec(Y1,Delta);
   end;
   if Y1 < 1 then
      Y1 := 1;
   if Y2 > HardVars.Depth then
      Y2 := HardVars.Depth;
end; { VerifyWindowOnScreen }

procedure CreateWin(x1,y1,x2,y2:integer);
{INTERNAL - called by MkWin and GrowMkWin}
begin
   if GoldMaxAvail >= sizeOf(Win[WindowCounter]^) then
   begin
      inc(WindowCounter);
      getmem(Win[WindowCounter],sizeof(Win[WindowCounter]^));    {allocate space}
      if GoldMaxAvail > succ(Y2-Y1)*succ(X2-X1)*2 then
      begin
         VerifyWindowOnScreen(X1,Y1,X2,Y2);
         OuterXY(X1,Y1,X2,Y2);
         getmem(Win[WindowCounter]^.ScreenPtr,succ(Y2-Y1)*succ(X2-X1)*2);
         PartSave(X1,Y1,X2,Y2,Win[WindowCounter]^.ScreenPtr^);
         with Win[WindowCounter]^ do
         begin
           Coord.X1 := X1;
           Coord.Y1 := Y1;
           Coord.X2 := X2;
           Coord.Y2 := Y2;
           CursorFind(CursorX,CursorY,ScanTop,ScanBot);
         end;  {with}
      end;
   end;
end; {CreateWin}

procedure MkWin(x1,y1,x2,y2,FB,Boxtype:integer);
{Main procedure for creating window}
begin
   if OnScreen then
   begin
      CreateWin(X1,Y1,X2,Y2);
      FBox(x1,y1,x2,y2,FB,BoxType);
      DrawShadow(X1,Y1,X2,Y2);
   end;
end; {MkWin}

procedure MkPopUpWin(var x1,y1,x2,y2:integer; FB1,FB2,style:byte);
{Used by Pull down menus}
begin
   CreateWin(X1,Y1,X2,Y2);
   VerifyWindowOnScreen(X1,Y1,X2,Y2);
   case style of
      1,2: begin
         Box3D(x1,y1,x2,y2,FB1,FB2,1);
         DrawShadow(X1,Y1,X2,Y2);
      end;
      3,4: begin
         FBox(succ(x1),y1,pred(x2),y2,FB2,4);
         DrawShadow(succ(X1),Y1,pred(X2),Y2);
      end;
   end;

end; {MkPopUpWin}

procedure GrowMKwin(x1,y1,x2,y2,FB,boxtype:integer);
{same as MKwin but window explodes}
var I : integer;
begin
   if OnScreen then
   begin
      CreateWin(X1,Y1,X2,Y2);
      GrowFBox(x1,y1,x2,y2,FB,BoxType);
      DrawShadow(X1,Y1,X2,Y2);
      with Win[WindowCounter]^ do
      begin
         X1 := Coord.X1;
         Y1 := Coord.Y1;
         X2 := Coord.X2;
         Y2 := Coord.Y2;
      end;  {with}
   end;
end; {GrowMKwin}

procedure RmWin;
begin
    if OnScreen and (WindowCounter > 0) then
    begin
       with Win[WindowCounter]^ do
       begin
          with Coord do
             PartRestore(X1,Y1,X2,Y2,ScreenPtr^);
          CursorPos(CursorX,CursorY);
          CursorSize(ScanTop,ScanBot);
          with Coord do
             freemem(ScreenPtr,succ(Y2-Y1)*succ(X2-X1)*2);
          freemem(Win[WindowCounter],sizeof(Win[WindowCounter]^));
       end; {with}
       dec(WindowCounter);
    end;
end; {RmWin}

                         {***********************}
                         {**  Window Routines  **}
                         {***********************}

function LastWinInChain: WStructurePtr;
{INTERNAL}
var Temp: WStructurePtr;
begin
   Temp := WinVars.FirstWin;
   while (Temp <> nil)
     and (Temp^.NextWinPtr <> nil) do
      Temp := Temp^.NextWinPtr;
   LastWinInChain := Temp;
end; {LastWinInChain}

function PrevWinInChain(WCP:WStructurePtr): WStructurePtr;
{INTERNAL}
var Temp: WStructurePtr;
begin
   Temp := WinVars.FirstWin;
   if Temp = WCP then
      Temp := nil
   else
   begin
      while (Temp <> nil)
        and (Temp^.NextWinPtr <> WCP) do
         Temp := Temp^.NextWinPtr;
   end;
   PrevWinInChain := Temp;
end; {PrevWinInChain}

function HighestWinNum:integer;
{}
var
  Temp: WStructurePtr;
  Num: integer;
begin
   Temp := WinVars.FirstWin;
   if Temp <> nil then
      Num := WinVars.FirstWin^.WinNum
   else
      Num := 0;
   while (Temp <> nil) and (Temp^.NextWinPtr <> nil) do
   begin
      if Temp^.WinNum > Num then
         Num := Temp^.WinNum;
      Temp := Temp^.NextWinPtr;
   end;
   HighestWinNum := Num;
end; {HighestWinNum}

function WinPtr(WinNum:integer):WStructurePtr;
{Returns a pointer to the window structure}
var Temp: WStructurePtr;
begin
   if WinNum = 0 then
      WinPtr := LastWinInChain
   else
   begin
      Temp := WinVars.FirstWin;
      WinPtr := nil;
      while (Temp <> nil) do
      begin
         if Temp^.WinNum = WinNum then
         begin
            WinPtr := Temp;
            exit;
         end
         else
            Temp := Temp^.NextWinPtr;
      end;
   end;
end; {WinPtr}

function WinCount: integer;
{}
var
  Temp: WStructurePtr;
  Counter: integer;
begin
   Temp := WinVars.FirstWin;
   Counter := 0;
   while Temp <> nil do
   begin
      inc(Counter);
      Temp := Temp^.NextWinPtr;
   end;
   WinCount := Counter;
end; { WinCount }

procedure ActivateWindow(Win:word);
{}
var
   Temp:WStructurePtr;
begin
   Temp := WinPtr(Win);
   if Temp <> nil then
      with Temp^ do
      begin
         VideoTarget.ScreenPtr := SurfacePtr;
         VideoTarget.Width := Width;
         VideoTarget.Depth := Depth;
         VideoTarget.WX1 := WinX1;
         VideoTarget.WY1 := WinY1;
         VideoTarget.WX2 := WinX2;
         VideoTarget.WY2 := WinY2;
         VideoTarget.WindowActive := GetBitStatus(WinState,WinConfine);
         VideoTarget.TargetType := WinTarget;
         VideoTarget.TargetPtr := Temp;
         VideoTarget.MoveCursor := Temp = LastWinInChain; {top window}
     end;
end; {ActivateWindow}

function WindowHasFocus: boolean;
{}
begin
   WindowHasFocus := (VideoTarget.TargetType = WinTarget);
end; { WindowHasFocus }

procedure ActivateTopWindow;
{}
var Temp: WStructurePtr;
begin
   Temp := LastWinInChain;
   if Temp <> nil then
      ActivateWindow(Temp^.WinNum);
end; { ActivateTopWindow }

procedure WinSetRegion(WP:WStructurePtr);
{}
begin
   with WP^ do
   begin
         case WinStyle of
            0 : begin
              WinX1 := 1;
              WinY1 := 1;
              WinX2 := width;
              WinY2 := depth;
            end;
            5: begin
              WinX1 := 2;
              WinY1 := 4;
              WinX2 := pred(width);
              WinY2 := depth;
            end;
            7,8: begin
              WinX1 := 3;
              WinY1 := 2;
              WinX2 := width - 2;
              WinY2 := pred(depth);
            end;
            9: begin
              WinX1 := 2;
              WinY1 := 5;
              WinX2 := pred(width);
              WinY2 := pred(depth);
            end;
            else begin
              WinX1 := 2;
              WinY1 := 2;
              WinX2 := pred(width);
              WinY2 := pred(depth);
            end;
         end; {case}
   end;
end; { WinSetRegion }

function WinCreate(X1,Y1,X2,Y2:integer;Style:byte): integer; {returns window handle}
{}
var
   T: TintElement;
   MemNeeded: integer;
   Temp: WStructurePtr;
   Charsize: byte;
begin
   MemNeeded :=  sizeof(WinVars.FirstWin^)+
                 succ(Y2-Y1)*succ(X2-X1)*2;
   if GoldMaxAvail < MemNeeded then
      WinCreate := 0
   else
   begin
      if WinVars.FirstWin = nil then
      begin
         getmem(WinVars.FirstWin,sizeof(WinVars.FirstWin^));
         WinList := WinVars.FirstWin;
         Temp := WinVars.FirstWin;
         SaveScreen(InternalScreen2);
         BackBuffer := FastVars.Screen[InternalScreen2]^.ScreenPtr;
         FrontUpdated := false;
      end
      else
      begin
        Temp := LastWinInChain;
        getmem(Temp^.NextWinPtr,sizeof(WinVars.FirstWin^));
        Temp := Temp^.NextWinPtr;
      end;
      with Temp^ do
      begin
         NextWinPtr := nil;
         WinNum := 0;   {goofy but necessary!}
         WinNum := succ(HighestWinNum);
         WinStyle := Style;
         Boundary := WinVars.Boundary;
         for T := FirstWinCol to LastWinCol do
             Col[T] := Tint[T];
         WinState := WinVars.WinState;
         Scroll := WinVars.Scroll;
         MinWidth := WinVars.MinWidth;
         MinDepth := WinVars.MinDepth;
         fillchar(PreZoom,sizeof(PreZoom),#0);
         StretchCallBack := NoStretchHook;
         ProcessKeyProc := NoKeyHandler;   {used by Desktop}
         CloseWinProc := BasicCloseHandler;
         ChangeFocusProc := BasicFocusHandler;
         WinCreate := WinNum;
         Title := '';
         Painted := false;
         getmem(SurfacePtr,succ(Y2-Y1)*succ(X2-X1)*2);
         X := X1;
         Y := Y1;
         Width := succ(X2-X1);
         Depth := succ(Y2-Y1);
         Cursor.X := 1;
         Cursor.Y := 1;
         CharSize := CharHeight;
         Cursor.Top := CharSize-3;
         Cursor.Bot := CharSize-2;
         UserData := nil;
      end;
      WinSetRegion(Temp);
   end;
end; {WinCreate}

procedure WinSetPosition(Win:integer;NewX,NewY:shortint);
{Changes the global position of the top left of the window; no
error checking is performed so the window can be placed totally of the screen}
var
   Temp: WStructurePtr;
begin
   Temp := WinPtr(Win);
   if Temp <> nil then
   begin
      Temp^.X := NewX;
      Temp^.Y := NewY;
   end;
end; {WinSetPosition}

procedure WinSetMinSize(Win:integer;Width,Depth: byte);
{}
var
   Temp: WStructurePtr;
begin
   Temp := WinPtr(Win);
   if Temp <> nil then
   begin
      Temp^.MinWidth := Width;
      Temp^.MinDepth := Depth;
   end;
end; { WinSetMinSize }

procedure WinSetType(Win:integer;W:WinType);
{}
var
   Temp: WStructurePtr;
begin
   Temp := WinPtr(Win);
   if Temp <> nil then
   begin
      with Temp^ do
         case W of
            WPlain: begin
               Scroll := NoScroll;
               SetBitStatus(WinState,WinAllowMove,false);
               SetBitStatus(WinState,WinAllowClose,false);
               SetBitStatus(WinState,WinAllowStretch,false);
            end;
            WClose: begin
               Scroll := NoScroll;
               SetBitStatus(WinState,WinAllowMove,false);
               SetBitStatus(WinState,WinAllowClose,true);
               SetBitStatus(WinState,WinAllowStretch,false);
            end;
            WMove: begin
               Scroll := NoScroll;
               SetBitStatus(WinState,WinAllowMove,true);
               SetBitStatus(WinState,WinAllowClose,true);
               SetBitStatus(WinState,WinAllowStretch,false);
            end;
            WMoveNoClose: begin
               Scroll := NoScroll;
               SetBitStatus(WinState,WinAllowMove,true);
               SetBitStatus(WinState,WinAllowClose,false);
               SetBitStatus(WinState,WinAllowStretch,false);
            end;
            WStretch: begin
               Scroll := NoScroll;
               SetBitStatus(WinState,WinAllowMove,true);
               SetBitStatus(WinState,WinAllowClose,true);
               SetBitStatus(WinState,WinAllowStretch,true);
               SetBitStatus(WinState,WinSmartStretch,false);
               StretchCallBack := NoStretchHook;
            end;
         end; {case}
   end;
end; {WinSetType}

procedure WinSetScrollType(Win:integer;S:ScrollType);
{}
var
   Temp: WStructurePtr;
begin
   Temp := WinPtr(Win);
   if Temp <> nil then
      Temp^.Scroll := S;
end; {WinSetScrollType}

procedure WinSetBoundary(Win,BX1,BY1,BX2,BY2:integer);
{}
var
   Temp: WStructurePtr;
begin
   Temp := WinPtr(Win);
   if Temp <> nil then
      with Temp^.Boundary do
      begin
         X1 := BX1;
         Y1 := BY1;
         X2 := BX2;
         Y2 := BY2;
      end;
end; {WinSetBoundary}

procedure WinSetColor(Win:integer; A:TintElement;C:byte);
{}
var
   Temp: WStructurePtr;
begin
   Temp := WinPtr(Win);
   if Temp <> nil then
   begin
      if A in [WinBorder..WinBorderOff] then
         Temp^.Col[A] := C;
   end;
end; {WinSetColor}

procedure WinSetTitle(Win:integer;Tit:string);
{}
var
   Temp: WStructurePtr;
begin
   Temp := WinPtr(Win);
   if Temp <> nil then
      Temp^.Title := Tit;
end; {WinSetTitle}

procedure WinSetShowNum(Win:integer;On:boolean);
{}
var
   Temp: WStructurePtr;
begin
   Temp := WinPtr(Win);
   if Temp <> nil then
      SetBitStatus(Temp^.WinState,WinShowNum,On);
end; {WinSetShowNum}

procedure WinSetStretchProc(Win:integer;S:StretchProc);
{}
var
   Temp: WStructurePtr;
begin
   Temp := WinPtr(Win);
   if Temp <> nil then
   begin
      Temp^.StretchCallBack := S;
      SetBitStatus(Temp^.WinState,WinSmartStretch,(@S <> @NoStretchHook));
   end;
end; {WinSetStretchProc}

procedure DrawHorizBar(WinId:integer;Current,Max: longint);
{}
var
   Temp: WStructurePtr;
  WasOn: boolean;
  CursX,CursY : byte;
begin
   Temp := WinPtr(WinId);
   if (Temp <> nil) and (Temp^.Scroll in [HorizScroll,BothScroll]) then
   with Temp^ do
   begin
      CursX := WhereX;
      CursY := WhereY;
      WasOn := GetSetWinIgnore(true);
         WriteHScrollBar(2,width-1,Depth,0,Current,Max);
      if not WasOn then
         SetWinIgnore(false);
      GotoXY(CursX,CursY);
   end;
end; {DrawHorizBar}

procedure DrawVertBar(WinId:integer;Current,Max: longint);
{}
var
   Temp: WStructurePtr;
   WasOn: boolean;
   CursX,CursY : byte;
begin
   Temp := WinPtr(WinId);
   if (Temp <> nil) and (Temp^.Scroll in [VertScroll,BothScroll]) then
   with Temp^ do
   begin
      CursX := WhereX;
      CursY := WhereY;
      WasOn := GetSetWinIgnore(true);
      WriteVScrollBar(width,2,pred(depth),0,Current,Max);
      if not WasOn then
         SetWinIgnore(false);
      GotoXY(CursX,CursY);
   end;
end; {DrawVertBar}

{     Window Styles:   0   -   No Border
                       1   -   Single Line Border - Standard
                       2   -   Double Line Border
                       3   -   Title Bar (caption)
                       4   -   Edge Border w/o title bar
                       5   -   Menu Style a la Professional Write
                       6   -   Edge Border with title bar
                       7   -   Chisel Raised
                       8   -   Chisel Sunken
}

procedure WriteCustomCloseIcon(A:byte);
{}
begin
   if FastVars.CustomCharsActive then
      WriteAT(1,1,A,chr(206)+char(207))
   else
      WriteAT(1,1,A,' - ');
end; { WriteCustomCloseIcon }

procedure WriteCustomZoomIcon(Width,A:byte);
{}
begin
   if FastVars.CustomCharsActive then
      WriteAT(pred(Width),1,A,chr(205)+char(216))
   else
      WriteAT(Width-2,1,A,'  ');
end; { WriteCustomZoomIcon }

procedure DrawFrame(WinId:integer;Active:boolean);
{}
var
   Temp: WStructurePtr;
   YT:integer;
   IgnoreState: boolean;
   TheStyle: byte;
   DrawNumbers: boolean;

   procedure DisplayTitle(A:byte);
   {}
   begin
      with Temp^ do
      begin
         if Title <> '' then
         begin
            if (TheStyle = 5)
            or (TheStyle = 9) then
               YT := 2
            else
               YT:= 1;
            if ((TheStyle in [1,2,7,8]) or ((TheStyle = 4) and (not FastVars.CustomCharsActive)))
            and (length(Title) >= Width - 10 - 5*ord(DrawNumbers)) then
               WriteCenter(YT,A,Squeeze('L',Title,Width - 10 - 5*ord(DrawNumbers)))
            else if TheStyle in  [3,6] then
               WriteCenter(YT,0,Title)
            else
               WriteCenter(YT,A,Title);
         end;
       end;
   end; { DisplayTitle }

   procedure DisplayNumber(A:byte);
   {}
   begin
      if DrawNumbers then with Temp^ do
      begin
         if ((TheStyle in [1,2,7,8]) or ((TheStyle = 4) and (not FastVars.CustomCharsActive)))
         and GetBitStatus(WinState,WinAllowStretch)
         and (Active or (WinVars.DesktopFadeStyle = 0))  then
            WriteRight(Width-6,1,A,IntToStr(WinNum))
         else if TheStyle in [4,6] then
            WriteRight(Width-4,1,A,IntToStr(WinNum))
         else
            WriteRight(Width-2,1,A,IntToStr(WinNum));
      end;
   end; { DisplayNumber }

   procedure DisplayCloseIcon;
   {}
   begin
      with Temp^ do
      if GetBitStatus(WinState,WinAllowClose) then
      begin
         if (TheStyle in [1,2,7,8]) or ((TheStyle = 4) and (not FastVars.CustomCharsActive)) then
         begin
            case TheStyle of
               7,8: begin
                  WriteAT(3,1,Col[WinBorder3DIn],'<');
                  WriteAT(5,1,Col[WinBorder3DOut],'>');
               end
               else
                  WriteAT(3,1,Col[WinBorder],'[ ]');
            end;
            WriteAT(4,1,Col[WinIcons],WinVars.WinCloseChar);
         end
         else if TheStyle in [3,6] then
             WriteCustomCloseIcon(Col[WinCustom]);
      end;
   end; { DisplayCloseIcon }

   procedure DisplayZoomIcon;
   {}
   begin
      with Temp^ do
      begin
         if (TheStyle in [1,2,7,8]) or ((TheStyle = 4) and (not FastVars.CustomCharsActive)) then
         begin
            case TheStyle of
               7,8: begin
                  WriteAT(Width-4,1,Col[WinBorder3DIn],'<');
                  WriteAT(Width-2,1,Col[WinBorder3DOut],'>');
               end;
               else
                  WriteAT(Width-4,1,Col[WinBorder],'[ ]');
            end; {case}
            if not GetBitStatus(WinState,WinZoomed) then
               WriteAT(Width-3,1,Col[WinIcons],WinVars.WinZoomMaxChar)
            else
               WriteAT(Width-3,1,Col[WinIcons],WinVars.WinZoomBackChar);
         end
         else if TheStyle in [3,6] then
            WriteCustomZoomIcon(Width,Col[WinCustom]);
      end; {case}
   end; { DisplayZoomIcon }

begin
   Temp := WinPtr(WinId);
   if Temp <> nil then
   with Temp^ do
   begin
      with WinVars do
      begin
         (*
         if DesktopActive and (DesktopFocusStyle <> 0) then
            TheStyle := DesktopFocusStyle
         else
            TheStyle := WinStyle;
         *)
         if DesktopActive and (DesktopFocusStyle <> 0) then
            Temp^.WinStyle := DesktopFocusStyle;
         TheStyle := WinStyle;
         if not DesktopActive then
            DrawNumbers := GetBitStatus(Temp^.WinState,WinShowNum)
         else
            case DesktopNums of
               WShowNumbers: DrawNumbers := true;
               WNoNumbers: DrawNumbers := false;
               else DrawNumbers := GetBitStatus(Temp^.WinState,WinShowNum);
            end; {case}
      end;
      ActivateWindow(WinId);
      IgnoreState := GetSetWinIgnore(true);
      if Active or (WinVars.DesktopFadeStyle = 0) then  {draw frame in all its glory}
      begin
         case TheStyle of
            7:Box3D(1,1,width,depth,Col[WinBorder3dOut],Col[WinBorder3dIn],TheStyle);
            8:Box3D(1,1,width,depth,Col[WinBorder3dIn],Col[WinBorder3dOut],TheStyle);
            else
               Box(1,1,width,depth,Col[WinBorder],TheStyle);
         end; {case}
         case TheStyle of
            3,6: ClearText(1,1,Width,1,Col[WinCaption]);
            7,8: ClearText(3,2,Width-2,depth-1,Col[WinBody]);
         end; {case}
         if TheStyle > 0 then
            DisplayTitle(Col[WinTitle]);
         DisplayCloseIcon;
         {Write the stretch icon at lower right}
         if ((TheStyle in [1,2,3,6,7,8]) or ((TheStyle = 4) and (not FastVars.CustomCharsActive)))
            and GetBitStatus(WinState,WinAllowStretch) then
         begin
            case TheStyle of
              1,4: WriteAt(Width,Depth,Col[WinIcons],'┘');
              2: if FastVars.CustomCharsActive then
                 WriteAt(Width,Depth,Col[WinIcons],'┘')
              else
                 WriteAt(Width,Depth,Col[WinIcons],'╝');
              7,8: WriteAt(Width,Depth,Col[WinIcons],'»');
            end; {case}
            DisplayZoomIcon;
         end;
         if TheStyle in [3,6] then
            DisplayNumber(Col[WinCaption])
         else
            DisplayNumber(Col[WinBorder]);
         DrawVertBar(WinID,1,100);
         DrawHorizBar(WinID,1,100);
      end
      else   {draw inactive frame}
      begin
         Box(1,1,width,depth,Col[WinBorderOff],WinVars.DesktopFadeStyle);
         DisplayTitle(Col[WinBorderOff]);
         DisplayNumber(Col[WinBorderOff]);
      end;
      SetWinIgnore(IgnoreState);
   end; {with}
end; {DrawFrame}

procedure WinPaint(Win:integer);
{Draws the window border and scrolls, etc. based on the WinStyle setting}
var
   VW:videoword;
   Temp: WStructurePtr;
begin
   Temp := WinPtr(Win);
   if (Temp <> nil) then
      with Temp^ do
      begin
         VW.Ch := ' ';
         VW.Attr := Col[WinBody];
         FillVideo(SurfacePtr^,Width*Depth,VW);
         DrawFrame(Win,true);
         Painted := true;
      end;
end; { WinPaint }

procedure WinDisplay(Win:integer);
{}
var
   Temp: WStructurePtr;
   MemoryNeeded: longint;
begin
   Temp := WinPtr(Win);
   if Temp <> nil then
   begin
      WinVars.TopWin := Temp;
      if not Temp^.Painted then
         WinPaint(Win);
      with Temp^ do
         SetBitStatus(WinState,WinZoomed,
                         (X = Boundary.X1)
                          and (Y = Boundary.Y1)
                          and (X + pred(width) = Boundary.X2)
                          and (Y + pred(depth) = Boundary.Y2)
                      );
   end;
end; {WinDisplay}

procedure WinSetFrame(Win:integer;Bright:boolean);
{Changes the window frame}
var
   Temp: WStructurePtr;
   WI:boolean;
begin
   Temp := WinPtr(Win);
   if Temp <> nil then
   begin
      WI := GetSetWinIgnore(true);
      DrawFrame(Win,bright);
      if not WI then
         SetWinIgnore(false);
   end;
end; {WinSetFrame}

procedure WinDispose(Win:integer);
{Removes the Window from the Window list, and disposes of allocated win memory}
var
   Prev,TheWin: WStructurePtr;
   WasTarget: boolean;
begin
   TheWin := WinPtr(Win);
   if TheWin <> nil then
   begin
      WasTarget := (VideoTarget.TargetType = WinTarget)
                   and
                   (WStructurePtr(VideoTarget.TargetPtr)^.WinNum = Win);
      Prev := WinVars.FirstWin;
      if Prev = TheWin then {first window in list}
         WinVars.FirstWin := TheWin^.NextWinPtr
      else
      begin
         while (Prev <> nil) and (Prev^.NextWinPtr <> TheWin) do
            Prev := Prev^.NextWinPtr;
         if Prev <> nil then
            Prev^.NextWinPtr := Prev^.NextWinPtr^.NextWinPtr; {pull window out of list}
      end;
      {free the memory allocated in TheWin}
      with TheWin^ do
         freemem(SurfacePtr,Width*Depth*2);
      freemem(TheWin,sizeof(TheWin^));
      if WinVars.FirstWin = nil then {last window removed dispose of screens}
      begin
         RestoreScreen(InternalScreen2);
         DisposeScreen(InternalScreen2);
         BackBuffer := nil;
         if WasTarget then
            ActivateVisibleScreen;
         WinList := nil;
         WinVars.TopWin := nil;
      end
      else
      begin
         WinVars.TopWin := lastWinInChain;
         if WasTarget then
            ActivateWindow(WinVars.TopWin^.WinNum);
         WinDrawAll;
         {restore cursor for new top window}
         with WinVars.TopWin^.Cursor do
         begin
            GotoXY(X,Y);
            CursorSize(Top,Bot);
         end;
      end;
   end;
end; {WinDispose}

                         {***********************}
                         {**  Moving Routines  **}
                         {***********************}

procedure MoveWin(UsingMouse:boolean;OldX,OldY:integer);
{Drags window around screen}
var
  Handle:integer;
  DeltaX, DeltaY,
  W,X1,Y1: integer;
  MX,MY: byte;
  Mvisible,
  WasOn,
  Left,Center,Right : boolean;
  ActiveWinPtr: WStructurePtr;
  T,B,CX,CY: byte;                   {cursor size}
begin
   ActiveWinPtr := LastWinInChain;
   if not UsingMouse then  {display Instructions on screen}
   begin
      W := length(WinVars.WinMoveMsgPart1)+2;
      X1 := (80 - W) div 2;
      Y1 := (HardVars.Depth - 3) div 2;
      Handle := WinCreate(X1,Y1,succ(X1+W),Y1+3,4);
      WinSetColor(Handle,WinBorder,Tint[WinMoveBody]);
      WinSetColor(Handle,WinIcons,Tint[WinMoveBody]);
      WinSetColor(Handle,WinBody,Tint[WinMoveBody]);
      WinPaint(Handle);
      ActivateWindow(handle);
      WriteCenter(1,0,WinVars.WinMoveMsgPart1);
      X1 := length(WinVars.WinMoveMsgPart2) - CharCount(HiMarker,WinVars.WinMoveMsgPart2);
      X1 := succ((W-X1) div 2);
      if X1 < 1 then
         X1 := 1;
      WriteHi(X1,2,Tint[WinMoveHi],Tint[WinMoveBody],WinVars.WinMoveMsgPart2);
      WinDrawAll;
      with WinVars.TopWin^.Cursor do
          GotoXY(W div 2,2);
   end
   else
   begin
      Handle := 0;
      MouseConfine(1,1+BBTop,80,HardVars.Depth - BBBot);
   end;
   CursorFind(CX,CY,T,B);
   repeat
     if UsingMouse then
     begin
        MouseShow(true);
        MouseStatus(Left,Center,Right,MX,MY);
     end
     else
     begin
        OldX := 20;
        OldY := 20;
        MY := 20;
        MX := 20;
        GetInput;
        case KeyVars.LastKey of
           328: dec(MY); {up}
           336: inc(MY); {down}
           333: inc(MX); {right}
           331: dec(MX); {left}
        end; {case}
        Left := true;
     end;
     DeltaX := MX - OldX;
     DeltaY := MY - OldY;
     {see if window would be partially visible}
     with ActiveWinPtr^ do
     begin
        if  ( (pred(X + Width) + DeltaX >= Boundary.X1)
              and (X + DeltaX <= Boundary.X2)
            )
        and ( (pred(Y + Depth) + DeltaY >= Boundary.Y1)
              and (Y + DeltaY <= Boundary.Y2)
            )  then
        begin
           inc(X, DeltaX);
           inc(Y, DeltaY);
        end;
        if (DeltaX <> 0) or (DeltaY <> 0) then
        begin
           WinDrawAll;
           if UsingMouse then with ActiveWinPtr^.Cursor do
           begin
              CursorSize(T,B);
              GotoXY(X,Y);
           end;
        end;
     end;
     OldX := MX;
     OldY := MY;
  until (UsingMouse and (Left = false))
     or (((KeyVars.LastKey = 13)
          or
          (KeyVars.LastKey = 27)) and (UsingMouse = false)
        );
  if Handle <> 0 then
     WinDispose(Handle)
  else
     MouseConfine(1,1,80,HardVars.Depth);
end; {MoveWin}

                       {***************************}
                       {**  Stretching Routines  **}
                       {***************************}

procedure WinToggleZoom;
{zooms or unzooms a window}
var WasZoomed: boolean;
begin
   with WinVars.TopWin^ do
   begin
      WasZoomed := GetBitStatus(WinState,WinZoomed);
      if not WasZoomed and
         (GoldMemAvail < (succ(Boundary.X2 - Boundary.X1)
                        * succ(Boundary.Y2 - Boundary.Y1)
                        * 2)
                        -
                        (Width*Depth*2)
         ) then
         exit; {no memory for new larger window}
      SetBitStatus(WinState,WinZoomed,not WasZoomed);
      freemem(SurfacePtr,Width*Depth*2);
      if WasZoomed then
      begin
         if PreZoom.X1 <> 0 then
         begin
            X :=  PreZoom.X1;   {set zone coords back to the old coords}
            Y :=  PreZoom.Y1;
            Width := succ(PreZoom.X2 - PreZoom.X1);
            Depth := succ(PreZoom.Y2 - PreZoom.Y1);
         end;
      end
      else
      begin
         PreZoom.X1 := X;  {save the un-zoomed coordinates}
         PreZoom.Y1 := Y;
         PreZoom.X2 := pred(X + Width);
         PreZoom.Y2 := pred(Y + Depth);
         X := Boundary.X1; {set window coords to the maximum}
         Y := Boundary.Y1 + BBTop;
         Width := succ(Boundary.X2 - Boundary.X1);
         Depth := succ(Boundary.Y2 - Boundary.Y1) - BBBot - BBTop;
      end;
      getmem(SurfacePtr,width*depth*2);
      WinSetRegion(WinVars.TopWin);
      ActivateWindow(0);   {update video target}
      WinPaint(0);
   end;
end; {WinToggleZoom}

procedure WinPostStretch(X1,Y1,X2,Y2: integer);
{}
var Zoomed: boolean;
begin
   ActivateTopWindow;
   with WinVars.TopWin^ do
   begin
      Zoomed := (X1 = Boundary.X1)
                and (Y1 = Boundary.Y1)
                and (X2 = Boundary.X2)
                and (Y2 = Boundary.Y2);
      SetBitStatus(WinState,WinZoomed,Zoomed);
      if Zoomed then
      begin
         PreZoom.X1 := X;  {save the un-zoomed coordinates}
         PreZoom.Y1 := Y;
         PreZoom.X2 := pred(X + Width);
         PreZoom.Y2 := pred(Y + Depth);
      end;
      X := X1;
      Y := Y1;
      Width := succ(X2-X1);
      Depth := succ(Y2-Y1);
      getmem(SurfacePtr,width*depth*2);
   end;
   WinSetRegion(WinVars.TopWin);
   ActivateWindow(0);   {update video target}
   WinPaint(0);
end; { WinPostStretch }

procedure WinStretch(UsingMouse:boolean;OldX,OldY:byte);
{}
const
   BorderChar = '█';
   BorderCol = white;
var
   Mvisible,
   IgnoreState,
   Zoomed,
   Left,Center,Right : boolean;
   MX,MY: byte;
   CTop,CBot,CX,CY:byte;
   NewX,NewY: byte;
   X1,Y1,X2,Y2: byte;

   procedure DisplayStrip(X1,Y1,X2,Y2:byte);
   {}
   begin
      MoveToScreen(X1,Y1,X2,Y2,HardVars.Width,FrontBuffer^,X1,Y1,HardVars.Width,HardVars.ScreenPtr^);
   end; { DisplayStrip }

   procedure ChangePerimeter;
   {}
   var
     I : integer;
   begin
      if MVisible then
         MouseShow(false);
      with WinVars.TopWin^ do
      begin
         if NewX <> X2 then
         begin
            DisplayStrip(X2,Y1,X2,Y2);
            if NewX < X2 then
            begin
               DisplayStrip(succ(NewX),Y1,X2,Y2);
               DisplayStrip(succ(NewX),Y2,X2,Y2);
            end;
         end; {with}
         if NewY <> Y2 then
         begin
            DisplayStrip(X1,Y2,X2,Y2);
            if NewY < Y2 then
            begin
               DisplayStrip(X1,succ(NewY),X2,Y2);
               DisplayStrip(X2,succ(NewY),X2,Y2);
            end;
         end; {with}
         {draw new perimiter}
         X2 := NewX;
         Y2 := NewY;
         Box(X1,Y1,X2,Y2,Cattr(white,black),ord(BorderChar));
      end; {with}
      if MVisible then
         MouseShow(true);
   end; {ChangePerimeter}

begin
   if GoldMaxAvail < 2*HardVars.Width*HardVars.Depth then
   begin
      Beep;
      exit;
   end;
   MVisible := KeyVars.MouseVisible;
   IgnoreState := GetSetWinIgnore(true);
   WinRedraw(false);    {creates image of display at FrontBuffer}
   with WinVars.TopWin^ do
      freemem(SurfacePtr,Width*Depth*2);
   X1 := WinVars.TopWin^.X;
   Y1 := WinVars.TopWin^.Y;
   X2 := X1 + pred(WinVars.TopWin^.Width);
   Y2 := Y1 + pred(WinVars.TopWin^.Depth);
   ActivateVisibleScreen;
   Box(X1,Y1,X2,Y2,Cattr(Bordercol,black),ord(BorderChar));
   OldX := X2;
   OldY := Y2;
   CursorFind(CX,CY,CTop,CBot);
   CursorOff;
   repeat
      if UsingMouse then
      begin
         MouseShow(true);
         MouseStatus(Left,Center,Right,MX,MY);
      end
      else
      begin
         OldX := X2;
         OldY := Y2;
         MY := OldY;
         MX := OldX;
         GetInput;
         case KeyVars.LastKey of
            328: dec(MY); {up}
            336: inc(MY); {down}
            333: inc(MX); {right}
            331: dec(MX); {left}
         end; {case}
         Left := true;
      end;
      if Left and ( (MX <> OldX) or (MY <> OldY) ) then  {stretch window}
      begin
         if (succ(MX - X1 ) < WinVars.TopWin^.MinWidth) then  {too small}
            NewX := pred(X1 + WinVars.TopWin^.MinWidth)
         else
         if (MX > WinVars.TopWin^.Boundary.X2) then                 {out of bounds}
            NewX := WinVars.TopWin^.Boundary.X2
         else
            NewX := MX;
         if (succ(MY - Y1 ) < WinVars.TopWin^.MinDepth) then  {too small}
            NewY := pred(Y1 + WinVars.TopWin^.MinDepth)
         else
         if (MY > WinVars.TopWin^.Boundary.Y2) then                 {out of bounds}
            NewY := WinVars.TopWin^.Boundary.Y2
         else
            NewY := MY;
         ChangePerimeter;
         WinVars.TopWin^.StretchCallBack(X1,Y1,X2,Y2);
         OldX := NewX;
         OldY := NewY;
      end; {if}
   until (UsingMouse and (Left = false)) or (((KeyVars.LastKey =13) or (KeyVars.LastKey = 27)) and (UsingMouse = false));
   WinPostStretch(X1,Y1,X2,Y2);
   SetWinIgnore(IgnoreState);
   GotoXY(1,1);
   CursorSize(CTop,CBot);
   if MVisible then
      MouseShow(true);
end; {WinStretch}

                     {*******************************}
                     {**  Changing Focus Routines  **}
                     {*******************************}
procedure WinFadeTopWin;
{Turns the border of the top window to the "not-focussed" state}
var
   Temp: WStructurePtr;
begin
   Temp := WinPtr(0);
   if (Temp <> nil) then
      DrawFrame(Temp^.WinNum,false);
end; {WinFadeTopWin}

procedure WinFocusTopWin;
{Turns the border of the top window to the "focussed" state}
var
   Temp: WStructurePtr;
begin
   Temp := WinPtr(0);
   if (Temp <> nil) then
      DrawFrame(Temp^.WinNum,true);
end; {WinFadeFocusWin}

procedure WinChangeFocus(WinId:integer);
{Brings the window to the top of the visible stack, i.e. to the
 bottom of the list}
var
   TheWin,TempWin: WStructurePtr;
begin
   TheWin := WinPtr(WinId);
   if (TheWin <> nil) and (TheWin <> LastWinInChain) then
   begin
      WinFadeTopWin;
      if TheWin = WinVars.FirstWin then
      begin
         WinVars.FirstWin := WinVars.FirstWin^.NextWinPtr;
         WinList := WinVars.FirstWin;
      end
      else
      begin
         TempWin := PrevWinInChain(TheWin);
         TempWin^.NextWinPtr := TempWin^.NextWinPtr^.NextWinPtr;
      end;
      TempWin := LastWinInChain;
      TempWin^.NextWinPtr := TheWin;
      TheWin^.NextWinPtr := nil;
      WinVars.TopWin := TheWin;
      WinFocusTopWin;
      WinDrawAll;
      {move the cursor?}
   end;
end; {WinChangeFocus}

procedure DeskNextWinCoords(var TLX,TLY: byte);
{Returns the position of the top left of the next new window on the desktop}
var
   X1,Y1: integer;
   Temp: WStructurePtr;

   procedure SetTopLeft;
   {}
   begin
      Y1 := succ(BBTop);
      X1 := 1;
   end; { SetTopLeft }

begin
   Temp := WinPtr(0);
   if Temp <> nil then with temp^ do
   begin
      X1 := succ(X);
      Y1 := succ(Y);
      if (X1 < 1) or (X1 > HardVars.Width - 3)
      or (Y1 < succ(BBTop)) or (Y1 > HardVars.depth-BBbot - 2) then
         SetTopLeft;
   end
   else
      SetTopLeft;
   TLX := X1;
   TLY := Y1;
end; { DeskNextWinCoords }

function WinWithFocus:integer;
{Returns the ID of the window at the top}
begin
   if WinVars.TopWin = nil then
      WinWithFocus := 0
   else
      WinWithFocus := WinVars.TopWin^.WinNum;
end; { WinWithFocus }

procedure WinShiftFocus;
{Rotates the window list so the top window moves to the bottom}
begin

end; { WinShiftFocus }

function CloseTrace(CX,CY:byte): boolean;
{Follows cursor around to see if user releases button over close icon}
var
   L,M,R,Ignore,Down: boolean;
   X,Y: byte;
begin
   Ignore := GetSetWinIgnore(true);
   Down := false;
   repeat
      MouseStatus(L,M,R,X,Y);
      if (Y = CY) and (X >= CX) and (X <= CX+2) then
      begin
         if not down then
         begin
            WritePlain(4,1,WinVars.WinCloseCharDown);
            WinDrawTop;
            Down:= true;
         end;
      end
      else
      begin
         if Down then
         begin
            WritePlain(4,1,WinVars.WinCloseChar);
            WinDrawTop;
            Down := false;
         end;
      end;
   until not L;
   WritePlain(4,1,WinVars.WinCloseChar);
   SetWinIgnore(Ignore);
   CloseTrace := (Y = CY) and (X >= CX) and (X <= CX+2);
end; { CloseTrace }

function CloseTraceCustom(CX,CY:byte): boolean;
{Follows cursor around to see if user releases button over close icon}
var
   L,M,R,Ignore,Down: boolean;
   X,Y,A1,A2: byte;
begin
   A1 := WinPtr(0)^.Col[WinCustom];
   A2 := WinPtr(0)^.Col[WinIcons];
   if A2 = A1 then
      A2 := 95;
   Down := false;
   Ignore := GetSetWinIgnore(true);
   repeat
      MouseStatus(L,M,R,X,Y);
      if (Y = CY) and (X >= CX) and (X <= succ(CX)+ ord(not FastVars.CustomCharsActive)) then
      begin
         if not down then
         begin
            WriteCustomCloseIcon(A2);
            MouseShow(false);
            WinDrawTop;
            Down:= true;
         end;
      end
      else
      begin
         if Down then
         begin
            WriteCustomCloseIcon(A1);
            WinDrawTop;
            MouseShow(true);
            Down := false;
         end;
      end;
   until not L;
   SetWinIgnore(Ignore);
   MouseShow(true);
   CloseTraceCustom := (Y = CY) and (X >= CX) and (X <= succ(CX)+ ord(not FastVars.CustomCharsActive));
end; { CloseTraceCustom }

function ZoomTrace(CX,CY:byte): boolean;
{Follows cursor around to see if user releases button over zoom icon}
var
   L,M,R,Ignore,Down: boolean;
   TempX,TempY: byte;
   WP: WStructurePtr;
begin
   Ignore := GetSetWinIgnore(true);
   Down := false;
   WP := WinPtr(0);
   with WP^ do
   repeat
      MouseStatus(L,M,R,TempX,TempY);
      if (TempY = CY) and (TempX >= CX) and (TempX <= CX+2) then
      begin
         if not down then
         begin
            WritePlain(Width-3,1,WinVars.WinCloseCharDown);
            WinDrawTop;
            Down:= true;
         end;
      end
      else
      begin
         if Down then
         begin
            if GetBitStatus(WinState,WinZoomed) then
               WritePlain(width-3,1,WinVars.WinZoomBackChar)
            else
               WritePlain(width-3,1,WinVars.WinZoomMaxChar);
            WinDrawTop;
            Down := false;
         end;
      end;
   until not L;
   SetWinIgnore(Ignore);
   with WP^ do
      ZoomTrace := (TempY = CY) and (TempX >= CX) and (TempX <= CX+2);
end; { ZoomTrace }

function ZoomTraceCustom(CX,CY:byte): boolean;
{Follows cursor around to see if user releases button over zoom icon}
var
   L,M,R,Ignore,Down: boolean;
   WX,TempX,TempY,A1,A2: byte;
   WP: WStructurePtr;
begin
   WP := WinPtr(0);
   A1 := WP^.Col[WinCustom];
   A2 := WP^.Col[WinIcons];
   WX := WP^.Width;
   if A2 = A1 then
      A2 := 95;
   Down := false;
   Ignore := GetSetWinIgnore(true);
   with WP^ do
   repeat
      MouseStatus(L,M,R,TempX,TempY);
      if (TempY = CY) and (TempX >= CX-1-ord(not FastVars.CustomCharsActive)) and (TempX <= CX) then
      begin
         if not down then
         begin
            WriteCustomZoomIcon(WX,A2);
            MouseShow(false);
            WinDrawTop;
            Down:= true;
         end;
      end
      else
      begin
         if Down then
         begin
            WriteCustomZoomIcon(WX,A1);
            WinDrawTop;
            MouseShow(true);
            Down := false;
         end;
      end;
   until not L;
   SetWinIgnore(Ignore);
   MouseShow(true);
   with WP^ do
      ZoomTraceCustom := (TempY = CY) and (TempX >= CX-1-ord(not FastVars.CustomCharsActive)) and (TempX <= CX);
end; { ZoomTraceCustom }

                     {*******************************}
                     {**  Key Management Routines  **}
                     {*******************************}

function IsWinKey(K:word;KX,KY:Integer):boolean;
{}
begin
   with WinVars do
     IsWinKey := (((K = Movekey) or (K =DeskCascadeKey)) and GetBitStatus(TopWin^.WinState,WinAllowMove))
                 or
                 (((K = ZoomKey) or (K=StretchKey) or (K=DeskTileKey)) and GetBitStatus(TopWin^.WinState,WinAllowStretch))
                 or
                 ((K = CloseKey) and GetBitStatus(TopWin^.WinState,WinAllowClose))
                 or
                 ( ((K = 500) or (K = 520) or (K=540))
                   and
                   OnBorder(KX,KY,TopWin^.X,TopWin^.Y,TopWin^.Width,TopWin^.Depth)
                 );
end; {IsWinKey}

function IsFocusKey(K:word;KX,KY:Integer):byte;
{Returns the ID of the window that is to assume focus, or
 zero if there is no focus change}
var Temp: WStructurePtr;
begin
   IsFocusKey := 0;
   if (K >= 376) and (K <= 385) then {Alt-1 to Alt-0}
   begin
      Temp := WinPtr(K - 375);
      if Temp <> nil then
      begin
         IsFocusKey := K - 375;
         exit;
      end;
   end;
   if K = 500 then
   begin
      Temp := LastWinInChain;
      if not WithinBorder(KX,KY,Temp^.X,Temp^.Y,Temp^.Width,Temp^.Depth) then
         while Temp <> nil do
         begin
            Temp := PrevWinInChain(Temp);
            if WithinBorder(KX,KY,Temp^.X,Temp^.Y,Temp^.Width,Temp^.Depth) then
            begin
               IsFocusKey := Temp^.WinNum;
               exit;
            end;
         end;
   end;
end; {IsFocusKey}

procedure WinProcessKey(var K:word; var KX,KY:byte);
{}
var PosX,PosY: shortint;
begin
   if WinVars.TopWin <> nil then
      with WinVars.TopWin^ do
      begin
         if (K = DeskCascadeKey) and GetBitStatus(WinState,WinAllowMove) then
         begin
            X := KeyVars.LastX;
            Y := KeyVars.LastY;
            if GetBitStatus(WinState,WinAllowStretch)  then {stretch to lower right of desktop}
            begin
               K := 602;
               Width := HardVars.Width - pred(X);
               Depth := HardVars.Depth - pred(Y) - BBBot;
            end
            else {just move the top left position of the window}
               K := 601;
         end
         else if (K = DeskTileKey) and GetBitStatus(WinState,WinAllowMove)
              and GetBitStatus(WinState,WinAllowStretch) then
         begin
            K := 602;
            X := KeyVars.LastX;
            Y := KeyVars.LastY;
         end
         else if (K = WinVars.StretchKey) and GetBitStatus(WinState,WinAllowStretch) then
         begin
            WinStretch(false,X,Y);
            K := 602;
         end
         else if (K = WinVars.ZoomKey) and GetBitStatus(WinState,WinAllowStretch) then
         begin
            WinToggleZoom;
            K := 602;
         end
         else if (K = WinVars.CloseKey) and GetBitStatus(WinState,WinAllowClose) then
         begin
            K := 600;
         end
         else if (K = WinVars.MoveKey) and GetBitStatus(WinState,WinAllowMove) then
         begin
            PosX := X;
            PosY := Y;
            MoveWin(false,X,Y);
            if (PosX <> X) or (PosY <> Y) then
               K := 601;
         end
         else if (K = 500) then
         begin
            if (KX = X + pred(Width)) and (KY = Y + pred(Depth)) and GetBitStatus(WinState,WinAllowStretch) then
            begin
               WinStretch(true,KX,KY);
               K := 602;
            end else if (KY = Y) and (KX >= X) and (KX < X+width) then
            begin
               if (KX >= X + 2)
               and (KX <= X + 4)
               and GetBitStatus(WinState,WinAllowClose)
               and ( (WinStyle in [1,2,7,8]) or ((WinStyle = 4) and (not FastVars.CustomCharsActive))) then
               begin
                  if CloseTrace(X + 2,Y) then
                     K := 600;  {Closed}
               end
               else if (KX >= X)
               and (KX <= succ(X) + ord(not FastVars.CustomCharsActive))
               and GetBitStatus(WinState,WinAllowClose)
               and (WinStyle in [3,6]) then
               begin
                  if CloseTraceCustom(X,Y) then
                     K := 600;
               end
               else if (KX >= X + width - 5)
               and (KX <= X + width - 3)
               and GetBitStatus(WinState,WinAllowStretch)
               and ( (WinStyle in [1,2,7,8]) or ((WinStyle = 4) and (not FastVars.CustomCharsActive))) then
               begin
                  if ZoomTrace(X + width - 5,Y) then
                  begin
                     WinToggleZoom;
                     K := 602;
                  end;
               end
               else if (KX >= X + width - 2 - ord(not FastVars.CustomCharsActive))
               and (KX <= X + pred(width))
               and GetBitStatus(WinState,WinAllowStretch)
               and (WinStyle in [3,6]) then
               begin
                  if ZoomTraceCustom(X + pred(width),Y) then
                  begin
                     WinToggleZoom;
                     K := 602;
                  end;
               end
               else if GetBitStatus(WinState,WinAllowMove) then
               begin
                  PosX := X;
                  PosY := Y;
                  MoveWin(true,KX,KY);

                  if (PosX <> X) and (PosY <> Y) then
                      K := 601;  {Moved}
               end;
            end
            else if ( (Scroll = HorizScroll)
                      or
                      (Scroll = BothScroll)
                    )
                 and (KX = X+pred(Width)) then
            begin
                if KY = succ(Y) then
                   K := 610
                else if KY =  Y + depth - 2  then
                   K := 611
                else if  (KY > Y+1)
                   and (KY < Y + depth -2) then {scroll bar}
                   begin
                      {adjust X to represent no of characters down scroll bar}
                      {adjust Y to return total length of scroll bar}
                      K := 614;
                      KX := KY - succ(Y);
                      KY := depth - 2;
                   end;
            end
            else  if ( (Scroll = VertScroll)
                       or
                       (Scroll = BothScroll)
                    )
                  and (KY = Y+pred(depth)) then
            begin
               if KX = succ(X) then
                  K := 612
               else if KX = X + width - 2 then
                  K := 613
               else if  (KX > succ(X))
                  and (KX < X + width - 2) then
                  begin
                     K := 615;
                     KX := KX - succ(X);
                     KY := width - 2;
                  end;
            end;
         end
         else if (K = 540) and (KY = Y) and (KX >= X) and (KX <= X + pred(Width))
         and GetBitStatus(WinState,WinAllowStretch) then
         begin
            WinToggleZoom;
            K := 602;
         end;
      end;
end; {WinProcessKey}

                   {***********************************}
                   {**  Message Displaying Routines  **}
                   {***********************************}

procedure TempMessageCh(X,Y,FB:integer;St:strscreen;var Ch:char);
{Retained for backward compatibility with TTT5 -  use Prompt procedures}
var
 CX,CY,CT,CB,I,locC:integer;
 SavedLine : array[1..160] of byte;
begin
    PartSave(X,Y,pred(X)+length(St),Y,SavedLine);
    WriteAT(X,Y,FB,St);
    GetInput;
    if KeyVars.LastKey <= 255 then
       Ch := chr(KeyVars.LastKey)
    else
       Ch := #0;
    PartRestore(X,Y,pred(X)+length(St),Y,SavedLine);
end; {TempMessageCh}

procedure TempMessage(X,Y,FB:integer;St:strscreen);
{Retained for backward compatibility with TTT5 -  use Prompt procedures}
var Ch : char;
begin
    TempMessageCH(X,Y,FB,ST,Ch);
end; {TempMessage}

procedure TempMessageBoxCh(X1,Y1,FB,BoxType:integer;St:strscreen;var Ch:char);
{Retained for backward compatibility with TTT5 -  use Prompt procedures}
begin
   MkWin(X1,Y1,succ(X1)+length(St),Y1+2,FB,Boxtype);
   WriteAt(succ(X1),Succ(Y1),FB,St);
   GetInput;
   if KeyVars.LastKey <= 255 then
      Ch := chr(KeyVars.LastKey)
   else
      Ch := #0;
   Rmwin;
end; {TempMessageBoxCh}

procedure TempMessageBox(X1,Y1,FB,BoxType:integer;St:strscreen);
var Ch : char;
begin
    TempMessageBoxCh(X1,Y1,FB,Boxtype,St,Ch);
end; {TempMessageBox}

function WinGlobalX(WinId:integer;X1:byte):byte;
{}
var
   Temp: WStructurePtr;
begin
   if WinID = 0 then
      Temp := LastWinInChain
   else
      Temp := WinPtr(WinId);
   if Temp <> nil then
   begin
      if X1 + pred(Temp^.X) + pred(Temp^.WinX1) < 0 then
         WinGlobalX := 0
      else
         WinGlobalX := X1 + pred(Temp^.X) + pred(Temp^.WinX1)
   end
   else
      WinGlobalX := X1;
end; {WinGlobalX}

function WinLocalX(WinId:integer;X1:byte):byte;
{Converts a full screen X coord to the coord with the window. If the X1 value
 does not fall within the window a zero is returned}
var
   Temp: WStructurePtr;
begin
   if WinID = 0 then
      Temp := LastWinInChain
   else
      Temp := WinPtr(WinId);
   if (Temp = nil)
   or (X1 < Temp^.X)
   or (X1 > Temp^.X + pred(Temp^.Width))
   or (X1 <= pred(Temp^.X) + pred(Temp^.WinX1)) then
      WinLocalX := 0
   else
      WinLocalX := X1 - pred(Temp^.X) - pred(Temp^.WinX1);
end; {WinLocalX}

function WinGlobalY(WinId:integer;Y1:byte):byte;
{}
var
   Temp: WStructurePtr;
begin
   if WinID = 0 then
      Temp := LastWinInChain
   else
      Temp := WinPtr(WinId);
   if Temp <> nil then
   begin
      if Y1 + pred(Temp^.Y) + pred(Temp^.WinY1) < 0 then
         WinGlobalY := 0
      else
         WinGlobalY := Y1 + pred(Temp^.Y) + pred(Temp^.WinY1)
   end
   else
      WinGlobalY := Y1;
end; {WinGlobalY}

function WinLocalY(WinId:integer;Y1:byte):byte;
{Converts a full screen Y coord to the coord with the window. If the Y1 value
 does not fall within the window a zero is returned}
var
   Temp: WStructurePtr;
begin
   if WinID = 0 then
      Temp := LastWinInChain
   else
      Temp := WinPtr(WinId);
   if (Temp = nil)
   or (Y1 < Temp^.Y)
   or (Y1 > Temp^.Y + pred(Temp^.depth)) then
      WinLocalY := 0
   else
      WinLocalY := Y1 - pred(Temp^.Y) - pred(Temp^.WinY1);
end; {WinLocalY}

                          {**********************}
                          {**  Prompt Dialogs  **}
                          {**********************}
function PromptEngine(UsingStr: boolean;
                      pStrLL: StringLLPtr; Tit,Str:string;
                      But1,But2,But3:StrButton;
                      HK1,HK2,HK3,Default:word;
                      WaitTime:longint; EscBut:byte): byte;
{Central function which displays a modal window and waits for
 the user to select one of up to three buttons}
const
   XGap = 3;
   YGap = 5;
   BGap = 5;
var
   {window and misc vars}
   X1,Y1,X2,Y2,W,BW,D,I,P: integer;
   Handle:integer;
   StartMemBuffer: longint;
   X,Y:byte;
   FirstKey: boolean;
   {buttonVars}
   Buts: ThreeButs;
   ActiveButton: byte;
   ClickedButton: byte;
   ButtonCount: byte;
   ButtonWasDown: boolean;
   {mouse related vars}
   MX,MY: byte;
   L,C,R,
   Finished,
   MVisible: boolean;

   procedure WriteButton(ButID:byte; Down,Force: boolean);
   {if Force is true the button will be redisplayed, even if the
    button state has not changed}
   begin
      if Force or (Down <> ButtonWasDown) then
         with Buts[ButID] do
         begin
            if Down then
               DrawButtonDown(X1,X2,Y2,Tint[PromptButtonHiHot],Tint[PromptButtonHi],
               Buts[ButID].ButtonFace)
            else
               if (ButID = ActiveButton) and (ButtonCount > 1) then
                  DrawButton(X1,X2,Y2,Tint[PromptButtonHiHot],Tint[PromptButtonHi],
                  Buts[ButID].ButtonFace)
               else
                  DrawButton(X1,X2,Y2,Tint[PromptButtonNormHot],Tint[PromptButtonNorm],
                  Buts[ButID].ButtonFace);
            ButtonWasDown := Down;
            if ButID = ActiveButton then
               GotoXY(X1+(X2 - X1) div 2 + ord(Down),Y2);
            WinDrawTop;
         end;
   end; {WriteButton}

   procedure SetButtonDetails;
   {}
   var I: integer;
   begin
      if But1 = '' then
         Buts[1].ButtonFace := '  ~O~K  '
      else
         Buts[1].ButtonFace := But1;
      Buts[2].Buttonface := But2;
      Buts[3].Buttonface := But3;
      {set X2 to width}
      for I := 1 to 3 do
         Buts[I].X2 := length(strip('A',HiMarker,Buts[I].ButtonFace));
      BW :=  Buts[1].X2
           + Buts[2].X2 + ord(Buts[2].X2>0) * BGAP
           + Buts[3].X2 + ord(Buts[3].X2>0) * BGAP;
      {see if the width of the buttons exceeds the widest line}
      if BW > W then
        W := BW;
   end; { SetButtonDetails }

   procedure PositionButtons;
   {Sets the button coordinates - at this point X1 contains the button width}
   var I: integer;
   begin
      Buts[1].X1 := (X2 - X1 - BW) div 2;
      Buts[1].X2 := Buts[1].X1 + pred(Buts[1].X2);
      for I := 2 to ButtonCount do
         if Buts[I].X2 > 0 then
         begin
            Buts[I].X1 := Buts[pred(I)].X2 + Bgap;
            Buts[I].X2 := Buts[I].X1 + pred(Buts[I].X2);
         end;
   end; { PositionButtons }

   function WhichButton(X:byte): byte;
   {Returns the ID of the button or zero if X doesn't fall on a button}
   begin
      if (X >= Buts[1].X1) and (X <= Buts[1].X2) then
         WhichButton := 1
      else if (ButtonCount > 1) and (X >= Buts[2].X1) and (X <= Buts[2].X2) then
         WhichButton := 2
      else if (ButtonCount = 3) and (X >= Buts[3].X1) and (X <= Buts[3].X2) then
         WhichButton := 3
      else
         WhichButton := 0;
   end; { WhichButton }

   function WhichHotkey(K:word): byte;
   {Converts character to uppercase and then compares to hot keys}
   begin
      if K = 0 then
         WhichHotkey := 0
      else
      begin
         if (K > 32) and (K <= 255) then
           K := ord(GetUpcase(chr(K)));
         if (K = HK1) then
            WhichHotkey := 1
         else if (K = HK2) and (ButtonCount > 1) then
            WhichHotkey := 2
         else if (K = HK3) and (ButtonCount = 3) then
            WhichHotkey := 3
         else
            WhichHotkey := 0;
      end;
   end; { WhichHotkey }

   procedure ActivateButton(NewID:byte);
   {}
   var OldBut: byte;
   begin
      if NewID <> ActiveButton then
      begin
         OldBut := ActiveButton;
         ActiveButton := 0;
         WriteButton(OldBut,false,true);
         ActiveButton := NewId;
         WriteButton(OldBut,false,true);
      end;
   end; { ActivateButton }

   procedure PWrite(X,Y:byte; S:string);
   {}
   begin
      if S[1] = '^' then
         WriteHiCenter(Y,Tint[PromptBodyHi],Tint[PromptBody],copy(S,2,255))
      else
         WriteHi(X,Y,Tint[PromptBodyHi],Tint[PromptBody],S);
   end; { PWrite }

   procedure WriteTheMessage;
   {}
   var I: integer;
   begin
      if D = 1 then
         PWrite(succ(XGap),2,Str)
      else
      begin
         for I := 1 to D do
         begin
            if UsingStr then
            begin
            P := pos(StrVars.LineBreak,Str);
            if P = 0 then
               PWrite(succ(XGap),succ(I),Str)
            else
               PWrite(succ(XGap),succ(I),copy(Str,1,pred(P)));
            delete(Str,1,P);
            end
            else
               PWrite(succ(XGap),succ(I),StrLLGetStr(pStrLL^,I));
         end;
      end;

   end; {WriteTheMessage}

begin
   StartMemBuffer := MiscVars.GoldMemBuffer; { use Total heap }
   MiscVars.GoldMemBuffer := 0;
   if UsingStr then
      W := WidestLine(Str)
   else
      W := StrLLWidestLine(pStrLL^);
   if W < length(Tit) then
      W := length(Tit);
   SetButtonDetails;
   if W + 2*succ(XGap) > HardVars.Width then
      W := HardVars.Width - 2*succ(XGap);
   if UsingStr then
      D := LineCount(Str)
   else
      D := pStrLL^.TotalNodes;
   if D + YGap > HardVars.Depth then
      D := HardVars.Depth - YGap;
   X1 := succ((HardVars.Width - W - 2*succ(XGap)) div 2);
   X2 := X1 + W + 2*succ(XGap);
   Y1 := succ((HardVars.Depth - D - YGap) div 2);
   Y2 := Y1 + D + YGap;
   Handle := WinCreate(X1,Y1,X2,Y2,WinVars.PromptStyle);
   WinSetType(Handle,WMoveNoClose);
   WinSetTitle(Handle,Tit);
   WinSetColor(Handle,WinBorder3DOut,Tint[PromptBorder1]);
   WinSetColor(Handle,WinBorder3DIn,Tint[PromptBorder2]);
   WinSetColor(Handle,WinBorder,Tint[PromptBorder1]);
   WinSetColor(Handle,WinBody,Tint[PromptBody]);
   WinSetColor(Handle,WinTitle,Tint[PromptTitle]);
   WinSetColor(Handle,WinCaption,Tint[PromptTitle]);
   WinSetShowNum(Handle,false);
   MVisible := KeyVars.MouseVisible;
   if not MVisible then
      MouseShow(true);
   WinDisplay(Handle);
   WriteTheMessage;
   {set coordinates of the button locations}
   ActiveButton := Default;
   if Buts[2].X2 = 0 then {ignore Button 3 if button 2 is nul}
      ButtonCount := 1
   else
      ButtonCount := 2 + ord(Buts[3].X2 > 0);
   if (ActiveButton < 1) or (ActiveButton > ButtonCount) then
      ActiveButton := 1;
   PositionButtons;
   Y2 := Y2-Y1-2;         {adjust Y2 to be button line}
   for I := 1 to ButtonCount do
      WriteButton(I,false,true);
   {some key processing stuff}
   Finished := false;
   MVisible := KeyVars.MouseVisible;
   (*
   WinDrawAll;
   *)
   WinDrawTop;
   if not MVisible then
      MouseShow(true);
   FirstKey := true;
   repeat
      GetInputWait(WaitTime);
      with KeyVars do
        if IsWinKey(LastKey,LastX,LastY) then
           WinProcessKey(LastKey,LastX,LastY);
        case KeyVars.Lastkey of
           0: begin
               if (WaitTime > 0) and FirstKey then {time expired}
               begin
                  WinDispose(Handle);
                  Finished := true;
                  ActiveButton := 0;
               end;
           end;
           600: begin {close icon}
               WinDispose(Handle);
               Finished := true;
               MouseRelease;
           end;
           601: begin  {window moved, but nothing to do}
           end;
           9,            {Tab, Right, Down}
           336,
           333: if ButtonCount > 1 then begin  {move right a button}
               if ActiveButton = ButtonCount then
                  ActivateButton(1)
               else
                  ActivateButton(succ(ActiveButton));
               WriteButton(ActiveButton,false,true);
           end;
           271,       {shift-Tab, up, left}
           331,
           328: if ButtonCount > 1 then begin  {move left a button}
               if ActiveButton = 1 then
                  ActivateButton(ButtonCount)
               else
                  ActivateButton(pred(ActiveButton));
               WriteButton(ActiveButton,false,true);
           end;
           13 :begin
              Finished := true;
              WinDispose(Handle);
           end;
           27: begin
              if EscBut <> 0 then
              begin
                 ActiveButton := EscBut;
                 Finished := true;
                 WinDispose(Handle);
              end;
           end;
           500: begin {left mouse down - animate the button}
              with KeyVars do
              begin
                 MX := WinLocalX(Handle,LastX);
                 MY := WinLocalY(Handle,LastY);
                 if (MY = Y2) then  {on button line}
                 begin
                    ClickedButton := WhichButton(MX);
                    if ClickedButton = 0 then
                       MouseRelease
                    else
                    begin
                       if ClickedButton <> ActiveButton then
                          ActivateButton(ClickedButton);
                       with Buts[ActiveButton] do
                       begin
                          repeat
                             MouseStatus(L,C,R,X,Y);
                             X := WinLocalX(Handle,X);
                             Y := WinLocalY(Handle,Y);
                             if L and ( (Y <> Y2) or (X < X1) or (X > X2+ord(ButtonWasDown))) then
                                WriteButton(ActiveButton,false,false)
                             else
                                WriteButton(ActiveButton,true,false);
                          until not L;
                          if (X >= X1) and (X <= X2+ord(ButtonWasDown)) and (Y = Y2) then
                          begin
                             Finished := true;
                             WinDispose(Handle);
                          end
                          else
                             WriteButton(ActiveButton,false,false);
                       end; {with}
                    end;
                 end
                 else
                    MouseRelease; {clicked away from buttons}
              end;
           end;  {case for 500}
           else begin
               ClickedButton := WhichHotKey(KeyVars.Lastkey);
               if ClickedButton <> 0 then
               begin
                  ActivateButton(ClickedButton);
                  Finished := true;
                  WinDispose(Handle);
               end;
           end;
        end; {case}
        FirstKey := false;
   until Finished;
   PromptEngine := ActiveButton;
   if not MVisible then
      MouseShow(false);
   MiscVars.GoldMemBuffer := StartMemBuffer;
end; { PromptEngine }

function PromptCustom(Tit,Str:string; But1,But2,But3:StrButton; HK1,HK2,HK3,Default:word; WaitTime:longint): byte;
{}
begin
   PromptCustom := PromptEngine(true,nil,Tit,Str,But1,But2,But3,HK1,HK2,HK3,Default,WaitTime,0);
end; { PromptCustom }

function PromptCustomStrLL(Tit:string; StrLL:StringLL; But1,But2,But3:StrButton;
                      HK1,HK2,HK3,Default:word; WaitTime:longint): byte;
{}
begin
   PromptCustomStrLL := PromptEngine(false,@StrLL,Tit,'',But1,But2,But3,HK1,HK2,HK3,Default,WaitTime,0);
end; { PromptCustomStrLL }

procedure PromptOK(Tit,Str:string);
{Displays a window with a short message and an OK button - the |
 character is used to split the lines}
begin
   with WinVars do
      if PromptEngine(true,nil,Tit,Str,OKbutStr,'','',OKHotKey,0,0,1,0,1) = 1 then;
end; { PromptOK }

procedure PromptOKStrLL(Tit:string;StrLL:StringLL);
{Displays a window with a short message and an OK button - the |
 character is used to split the lines}
begin
   with WinVars do
      if PromptEngine(false,@StrLL,Tit,'',OKbutStr,'','',OKHotKey,0,0,1,0,1) = 1 then;
end; { PromptOKStrLL }

function PromptYesNo(Tit,Str:string): byte;
{}
begin
   with WinVars do
      PromptYesNo := PromptEngine(true,nil,Tit,Str,YesButStr,NoButStr,'',YesHotKey,NoHotKey,0,1,0,2);
end; { PromptYesNo }

function PromptYesNoStrLL(Tit:string;StrLL:StringLL): byte;
{}
begin
   with WinVars do
      PromptYesNoStrLL := PromptEngine(false,@StrLL,Tit,'',YesButStr,NoButStr,'',YesHotKey,NoHotKey,0,1,0,2);
end; { PromptYesNoStrLL }

function PromptOKCancel(Tit,Str:string): byte;
{}
begin
   with WinVars do
      PromptOKCancel := PromptEngine(true,nil,Tit,Str,OKbutStr,CancelButStr,'',OKHotkey,CancelHotkey,0,1,0,2);
end; { PromptOKCancel }

function PromptOKCancelStrLL(Tit:string;StrLL:StringLL): byte;
{}
begin
   with WinVars do
      PromptOKCancelStrLL := PromptEngine(false,@StrLL,Tit,'',OKbutStr,
                                          CancelButStr,'',OKHotkey,CancelHotkey,0,1,0,2);
end; { PromptOKCancelStrLL }

                        {*************************}
                        {**  DRAGGING ROUTINES  **}
                        {*************************}

procedure DragItem(var X1,Y1,X2,Y2:byte;DragAttr:byte;UsingMouse:boolean;Fillch:char;FillAttr:byte);
var
   Left,Center,Right : boolean;
   OldX,OldY,
   X,Y : Byte;
   DeltaX, DeltaY : shortint;
   ScrPtr,
   OldPtr,
   SmartWinImagePtr : pointer;
   Wid: word;
   W,D: byte;
   Boundary,
   OldLocation : gCoords;

  procedure CaptureMoveableArea;
  {saves image of window}
  var I : integer;
  begin
     getmem(SmartWinImagePtr,W*D*2);
     PartSave(X1,Y1,X2,Y2,SmartWinImagePtr^);
  end; {CaptureMoveableArea}

  procedure RestoreSmartWin;
  {}
  begin
     PartRestore(X1,Y1,X2,Y2,SmartWinImagePtr^);
  end; {RestoreSmartWin}

  procedure DisposeSmartWin;
  {}
  begin
     freemem(SmartWinImagePtr,W*D*2);
  end; {DisposeSmartWin}

  procedure FastRestore(X1,Y1,X2,Y2:byte);
  {}
  var
     I,W : integer;
     ScreenAdr: integer;
  begin
     if (X1 > X2) or (Y1 > Y2) then
        exit;
     W := succ(X2 - X1);
     MoveToScreen(X1,Y1,X2,Y2,HardVars.Width,OldPtr^,X1,Y1,HardVars.Width,ScrPtr^);
  end; {FastRestore}

begin
   Boundary.X1 := 1;
   Boundary.Y1 := 1;
   Boundary.X2 := 80;
   Boundary.Y2 := 25;
   W := succ(X2 - X1);
   D := succ(Y2 - Y1);
   if GoldMaxAvail < W*D*2 * HardVars.Width*HardVars.Depth*2 then
   begin
      Beep;
      exit;
   end;
   CaptureMoveableArea;
   if DragAttr <> 0 then
   begin
      with Boundary do
         Attrib(X1,Y1,X2,Y2,DragAttr);
      RestoreSmartWin;
   end;
   SaveScreen(InternalScreen1);
   if FillCh <> #0 then
   begin
      ActivateVirtualScreen(InternalScreen1);
      PartClear(X1,Y1,X2,Y2,FillAttr,FillCh);
      ActivateVisibleScreen;
   end;
   ScrPtr :=  HardVars.ScreenPtr;
   OldPtr := FastVars.Screen[InternalScreen1]^.ScreenPtr;
   Wid := HardVars.Width*2;
   if UsingMouse then
      MouseStatus(Left,Center,Right,OldX,OldY);
   repeat
      if UsingMouse then
      begin
         MouseShow(true);
         MouseStatus(Left,Center,Right,X,Y);
      end
      else
      begin
         OldX := 20;
         OldY := 20;
         Y := 20;
         X := 20;
         GetInput;
         case KeyVars.LastKey of
            328: dec(Y); {up}
            336: inc(Y); {down}
            333: inc(X); {right}
            331: dec(X); {left}
         end; {case}
         Left := true;
      end;
      if Left and ( (X <> OldX) or (Y <> OldY) ) then  {move window}
      begin
         OldLocation.X1 := X1;
         OldLocation.Y1 := Y1;
         OldLocation.X2 := X2;
         OldLocation.Y2 := Y2;
         if (X <> OldX) then
         begin
            DeltaX := X - OldX;
            if  (DeltaX + X1 >= Boundary.X1)
            and (DeltaX + X2 <= Boundary.X2) then
            begin
               inc(X1,DeltaX);
               inc(X2,DeltaX);
            end
            else
              DeltaX := 0;
         end
         else
            DeltaX := 0;
         if (Y <> OldY) then
         begin
            DeltaY := Y - OldY;
            if  (DeltaY + Y1 >= Boundary.Y1)
            and (DeltaY + Y2 <= Boundary.Y2) then
            begin
               inc(Y1, DeltaY);
               inc(Y2, DeltaY);
            end
            else
              DeltaY := 0;
         end
         else
            DeltaY := 0;
         MouseShow(false);
         RestoreSmartWin;
         if DeltaX > 0 then {Viewport moved right}
            FastRestore(OldLocation.X1,Y1,pred(X1),Y2)
         else if DeltaX < 0 then {viewport moved left}
            FastRestore(succ(X2),Y1,OldLocation.X2,Y2);
         if DeltaY > 0 then {Viewport moved down}
            FastRestore(OldLocation.X1,OldLocation.Y1,X2,pred(Y1))
         else if deltaY < 0 then {Viewport moved up}
            FastRestore(OldLocation.X1,succ(Y2),X2,OldLocation.Y2);
         if DeltaX < 0 then    {moved left}
         begin
             if (DeltaY > 0) then
                FastRestore(succ(X1),OldLocation.Y1,Oldlocation.X2,pred(Y1))
             else
                FastRestore(succ(X2),succ(Y2),Oldlocation.X2,OldLocation.Y2);
         end;
         OldX := X;
         OldY := Y;
         {Mouse.Move(X,Y);}
      end; {if}
   until (UsingMouse and (Left = false))
      or (((KeyVars.LastKey = 13)
          or
          (KeyVars.LastKey = 27)) and (UsingMouse = false)
         );
   DisposeScreen(InternalScreen1);
   DisposeSmartWin;
end; {DragItem}

              {*********************************************}
              {**  U N I T   I N I T I A L I Z A T I O N  **}
              {*********************************************}

procedure WinDefaultSettings;
{}
begin
   with WinVars do
   begin
      RotateKey := 320;       {F6}
      MoveKey := 354;         {Ctrl-F5}
      ZoomKey := 319;         {F5}
      StretchKey := 364;      {Alt-F5}
      CloseKey := 362;        {Alt-F3}
      {defaults for new windows}
      WinState := 0; {set everything false}
      SetBitStatus(WinState,WinConfine,true); {window write limitations are active}
      (* DEVELOPER NOTE: Enable one or more of the following
                         to change defaults
      SetBitStatus(WinState,WinAllowMove,true);
      SetBitStatus(WinState,WinAllowClose,true);
      SetBitStatus(WinState,WinAllowStretch,true);
      SetBitStatus(WinState,WinShowNum,true);
      *)
      Scroll := NoScroll;
      PromptStyle := 7;
      DesktopFadeStyle := 1;
      DesktopFocusStyle := 2;
      DesktopNums := WShowNumbers;
      DesktopCascadeNew := true;
      MinWidth := 12;
      MinDepth := 7;
      with Boundary do
      begin
         X1 := 1;
         Y1 := 1;
         X2 := HardVars.Width;
         Y2 := HardVars.Depth;
      end;
      WinCloseChar := '■';
      WinCloseCharDown := '';
      WinZoomMaxChar := '';
      WinZoomBackChar := '';
      {move message}
      WinMoveMsgPart1 := 'Move window using arrow keys';
      WinMoveMsgPart2 := 'Press ~Enter~ when done';
      {buttons}
      OKButStr := '   ~O~K   ';
      OKHotKey := 280;          { Alt+O }
      CancelButStr := ' ~C~ancel ';
      CancelHotKey := 302;      { Alt+C }
      YesButStr := '   ~Y~es   ';
      YesHotKey := 277;         {Alt-Y}
      NoButStr := '   ~N~o   ';
      NoHotKey := 305;          {Alt-N}
      HelpButStr := '  ~H~elp  ';
      HelpHotKey := 291;
   end;
end; {WinDefaultSettings}

procedure GoldWinInit;
{}
begin
   with WinVars do
   begin
      LastECode := 0;
      FirstWin := nil;
      TopWin := nil;
      EMsgFunc := WinEMsg;
   end;
   WinDefaultSettings;
end; {GoldWinInit}

begin
   GoldWinInit;
end.